home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 098 / usrutil3.arc / USRUTIL3.BAS
Encoding:
BASIC Source File  |  1985-09-27  |  3.9 KB  |  77 lines
  1. 10 'USRUTIL3.BAS   -  Prints the  RBBS-PC user file in lastname, firstname sequence
  2. 20 ' Original USRUTIL1.BAS by Jon Martin
  3. 25 ' Modified to support CPC12.3A 11/20/84 by Michael L. Brown  Version 3.1 (12/11/84)
  4. 30 DEFINT A-Z:VER$="3.1":TI$=TIME$
  5. 35 ON ERROR GOTO 800
  6. 40 DEF FNFL$(A$)=LEFT$(MID$(A$+" , ",INSTR(A$+" , ",", ")+2),INSTR(MID$(A$+", ",INSTR(A$+", ",", ")+3)+"  ","  "))+LEFT$(A$+", ",INSTR(A$+", ",", ")-1)
  7. 50 DEF FNSS$(A$)=LEFT$(A$+"   ",INSTR(A$+"   ","   ")-1)
  8. 60 DEF FNPR$(A$,A%)=LEFT$(A$+SPACE$(A%),A%)
  9. 70 DEF FNCO$(A$)=MID$(A$,1,(INSTR(A$," ")-1))+", "+RIGHT$(A$,(LEN(A$)-INSTR(A$," ")))
  10. 80 KEY OFF
  11. 90 LINE.COUNT=66
  12. 100 CLS:DIM BUL$(6),MD(20),SA(12),UA(12),FS(8),LG$(18),HE$(8):TB$=" ":GOSUB 700
  13. 110 PRINT:PRINT:INPUT"ARE YOU READY TO PROCEED WITH PRINT USER FILE";Y$
  14. 120 IF LEFT$(Y$,1) = "Y" OR LEFT$(Y$,1) = "y" THEN 140
  15. 130 PRINT "PRINT USER FILE RUN ABORTED.":GOTO 520
  16. 140 CLS:PRINT "USRUTIL3.BAS  Version ";VER$:PRINT:PRINT "PRINT USER FILE RUN STARTED AT ";TIME$
  17. 150 OPEN "R",1,UF1$,128:END.USER=LOF(1)/128
  18. 160 OPEN "O",2,"SORT.INP"
  19. 170 FIELD 1,31 AS N$,15 AS PW$,2 AS SL$,14 AS OP$,24 AS CS$,19 AS MA$,14 AS TD$,3 AS LND$,2 AS UDL$,2 AS UUL$,2 AS ET$
  20. 180 UDX=1
  21. 190 IF UDX > END.USER THEN CLOSE 2:GOTO 300
  22. 200 GET 1,UDX
  23. 205 IF INSTR(N$,"NEWUSER") THEN 290
  24. 206 IF N$=SPACE$(31) THEN UDX=END.USER:GOTO 290
  25. 210 IF LEFT$(N$,5)=SPACE$(5) THEN 290
  26. 220 NAME.WORK$=FNSS$(N$)
  27. 230 NAME.WORK$=FNCO$(NAME.WORK$)
  28. 240 NAME.WORK$=FNFL$(NAME.WORK$)
  29. 250 NAME.WORK$=FNPR$(NAME.WORK$,31)
  30. 260 NUMBER.WORK$=FNPR$(STR$(UDX),5)
  31. 270 SORT.WORK$=NAME.WORK$+NUMBER.WORK$
  32. 280 PRINT#2,SORT.WORK$
  33. 290 UDX=UDX+1:GOTO 190
  34. 300 'SORT RECORDS
  35. 310 PRINT:PRINT"SORT PHASE STARTED AT ";TIME$
  36. 320 DEF SEG:PEEK.HOLD.ONE=PEEK(&H30):PEEK.HOLD.TWO=PEEK(&H31)
  37. 330 SHELL.HOLD$="SORT <SORT.INP >SORT.OUT":SHELL SHELL.HOLD$
  38. 340 POKE &H30,PEEK.HOLD.ONE:POKE &H31,PEEK.HOLD.TWO
  39. 350 PRINT:PRINT"SORT PHASE ENDED AT   ";TIME$
  40. 360 'FIND USERS
  41. 370 OPEN "I",2,"SORT.OUT"
  42. 380 IF EOF(2) THEN 520
  43. 390 INPUT#2,SORT.WORK$
  44. 400 UDX=VAL(RIGHT$(SORT.WORK$,5))
  45. 410 GET 1,UDX
  46. 420 IF ASC(N$)=0 THEN 380 ELSE OF=CVI(SL$):A$=RIGHT$("   "+STR$(LOC(1)),4)+":"+LEFT$(SORT.WORK$,31)+"SECURITY"+STR$(OF)+TB$:IF OF<MO THEN A$=A$+" <Locked out>":GOTO 440
  47. 430 A$=A$+"Pw="+PW$+"Times on"+STR$(CVI(MID$(OP$,1,2)))
  48. 440 GOSUB 560:LPRINT A$
  49. 450 IF SCL$="Y" THEN A$="   (SYSOP)    " ELSE A$="              "
  50. 460 A$=A$+TD$+" "+CS$+MA$
  51. 470 LPRINT A$
  52. 480 A$="     DOWNLOADS="+STR$(CVI(UDL$)):A$=A$+SPACE$(30-LEN(A$))+"UPLOADS="+STR$(CVI(UUL$)):A$=A$+SPACE$(60-LEN(A$))+"TIME USED="+STR$(CVI(ET$))+" Min."
  53. 490 LPRINT A$:LPRINT
  54. 500 LINE.COUNT=LINE.COUNT+4
  55. 510 GOTO 380
  56. 520 'END PROGRAM
  57. 530 PRINT:PRINT "PRINT USER FILE RUN ENDED AT ";TIME$
  58. 540 CLOSE:KILL "SORT.INP"
  59. 545 KILL "SORT.OUT"
  60. 550 LPRINT CHR$(12):END
  61. 560 IF LINE.COUNT< 60 THEN RETURN
  62. 570 LPRINT CHR$(12)
  63. 580 LPRINT DATE$;TAB(30);"RBBS-PC SORTED USER LIST";TAB(73);TI$
  64. 590 LPRINT:LPRINT:LINE.COUNT=3
  65. 600 RETURN
  66. 700 OPEN "I",3,"RBBS-PC.DEF":INPUT #3,FA$,PB$,PC$,NA$,NB$,CB,AA,AB,TV!,ME,DF,UB$,XPR,BC,BA,PRT,DF,ME$(1),ME$(2),ME$(3),ME$(4),ME$(5),CQ$,DF,OA,UE,PL,DF,WA,DF$
  67. 705 INPUT#3,MES1$,LG$(11),CF$,CG$,UF1$,WB$,LG$(12),DIR$,CP$,OB,SD,DF$,DA,FGR,BG,BDR,RC$,CH$,LG$(13),LG$(14)
  68. 710 INPUT#3,HE$(1),HE$(2),HE$(3),HE$(4),HE$(5),HE$(6),HE$(7),HE$(8),LG$(8),LG$(7),DF$,RD,BD,UDR,DF,SHRD,CYC,DF,TOA!,LG$(18):INPUT#3,MO,DB,SE,FB$,SF,KA$,VB,SA(1),SA(2),SA(3),SA(4),SA(5),SA(6),SA(7),SA(8),PD$,MP,DF,UPS,MTERM,DAY
  69. 720 INPUT#3,MD(1),MD(2),MD(3),MD(4),MD(5),MD(6),MD(7),MD(8),MD(9),MD(10),MD(11),MD(12),MD(13),MD(14),MD(15),MD(16),MD(17),MD(18),MD(19),MD(20)
  70. 725 INPUT#3,FS(1),FS(2),FS(3),FS(4),FS(5),FS(6),FS(7),FS(8),UA(1),UA(2),UA(3),UA(4),UA(5),UA(6),UA(7),UA(8),UA(9),UA(10),UA(11),UA(12),CPQ
  71. 730 CLOSE 3:RETURN
  72. 800 IF ERL = 540 THEN RESUME 545
  73. 810 IF ERL = 545 THEN RESUME 550
  74. 820 IF ERL<> 700 THEN CLS:PRINT"ERROR ";ERR;" IN LINE ";ERL:GOTO 840
  75. 830 CLS:PRINT"RBBS-PC.DEF FILE NOT FOUND."
  76. 840 PRINT"PROGRAM CANNOT CONTINUE":CLOSE:END
  77.